home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
graphic
/
tpega.zip
/
TPDEMO.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1986-03-20
|
13KB
|
479 lines
program Demo;
{ }
{ Program: Demo, Version 01/20/86 }
{ }
{ Description: Demonstrate some of the EGA graphic routines. }
{ }
{ Author: Kent Cedola }
{ 2015 Meadow Lake Court, Norfolk VA, 23518. 1-(804)-857-0613 }
{ }
{ Language: Turbo Pascal, V3.01A }
{ }
{ Comments: This program only includes the graphic routines needed to }
{ save space and time for BBS's. If you would like a complete }
{ set of EGA graphic routines (FREE), please let me know. }
{ }
{$K- }
{$I GPPARMS.P }
{$I GPINIT.P }
{$I GPTERM.P }
{$I GPCOLOR.P }
{$I GPSTYLE.P }
{$I GPSHADE.P }
{$I GPPAL.P }
{$I GPPLOT.P }
{$I GPBOX.P }
{$I GPBALL.P }
{$I GPMOVE.P }
{$I GPLINE.P }
{$I GPRECT.P }
{$I GPCIR.P }
{$I GPFLOOD.P }
{$I GPFILL.P }
{$I GPWINDOW.P }
{$I GPVIEWPO.P }
{$I GPSCALE.P }
{$I GPCLIP2.P }
{$I World.P }
procedure EGACOLOR(color: Integer); external 'PEGA_IO.BIN';
procedure EGAPLOT(X,Y: Integer); external EGACOLOR[3];
procedure EGALINE(X1,Y1,X2,Y2: Integer); external EGACOLOR[6];
procedure EGAFILLRECT(X1,Y1,X2,Y2: Integer); external EGACOLOR[9];
var
x,y: integer;
stat: integer;
Ch: char;
buff: array [0..15] of Byte;
Shade: array [0..15] of Byte;
procedure InitGraphics;
begin
GPPARMS; { Sets up all global variables }
if GDTYPE = 4 then { Give monochrome user bad news }
begin
writeln('Sorry, must have a Color Display not monochrome!');
halt(1);
end
else if GDTYPE <> 5 then { Tell non-EGA users no can run }
begin
writeln('Enhanced Color Adapter and Display not found!');
halt(2);
end;
if GDMEMORY = 64 then { We need lots of EGA memory }
begin
writeln('This program will work much better with 128k+ EGA memory!');
writeln(' Hit any key to continue!');
Read(Kbd,Ch);
end;
GPINIT; { We are now in graphic mode! }
buff[0] := 4;
buff[1] := Green;
buff[2] := Green;
buff[3] := Blue;
buff[4] := Blue;
GPSTYLE(buff);
end;
procedure TermGraphics;
begin
GPTERM; { Terminate graphic mode }
end;
{
Example on how to fill(flood) an area on the screen.
Written to test logic for 3-D hidden line removal. (works).
}
procedure TestFill;
begin
GPCOLOR(White); { Draw a white line across the screen }
GPMOVE(0,0);
GPLINE(GDMAXCOL,GDMAXROW);
GPCOLOR(Red); { Draw a Red rectangle }
GPMOVE(50,50);
GPRECT(300,100);
Read(KBD,Ch);
GPCOLOR(Green); { Fill in the area as GREEN }
GPMOVE(60,60); { VERY IMPORTANT: must set starting location }
GPFLOOD(Red); { Red = border for flood }
Read(KBD,Ch);
GPCOLOR(Blue); { Fill as Blue }
GPFLOOD(Red);
Read(KBD,Ch);
GPCOLOR(Red); { Fill as Red }
GPFLOOD(Red);
Read(KBD,Ch);
end;
procedure TitlePage;
begin { TitlePage }
GPCOLOR(Black);
GPMOVE(0,0);
GPBOX(GDMAXCOL,GDMAXROW);
TextColor(Cyan);
GotoXY( 3,2); Write('KC-TPDEMO Beta');
GotoXY(24,2); Write('Demonstration of Turbo Pascal & EGA');
GotoXY(68,2); Write('KC-Graphics');
GPCOLOR(Green);
GPMOVE(0,0);
GPRECT(GDMAXCOL,GDMAXROW);
GPMOVE(4,3);
GPRECT(GDMAXCOL-4,38);
GPMOVE(4,41);
GPRECT(124,346);
GPMOVE(128,41);
GPRECT(635,346);
end; { TitlePage }
procedure MapPage;
const
World: array [0..1250] of Integer =
(
168,2,16,3,16,3,15,4,14,6,14,6,12,8,12,9,10,10,10,12,9,15,9,17,10,
19,11,25,11,27,12,27,13,30,13,30,12,28,12,28,10,26,10,26,9,28,8,30,8,
30,9,32,10,32,9,33,9,33,12,31,12,32,13,35,13,35,11,37,9,39,9,36,12,
39,12,39,10,40,9,43,9,46,12,46,14,43,17,40,15,40,14,42,14,43,13,42,12,
40,12,40,13,38,14,38,16,34,16,30,19,30,20,33,22,34,22,34,25,37,21,
36,19,39,17,40,17,41,18,41,19,43,18,44,22,46,23,46,24,45,24,45,25,
45,26,46,26,46,28,43,27,43,26,45,25,42,25,39,25,40,27,40,30,37,30,
32,35,32,37,28,39,29,43,28,44,27,43,26,40,24,40,24,41,21,41,18,44,
18,46,17,47,19,49,21,48,21,46,24,46,22,51,25,51,25,55,28,55,28,56,
29,56,32,53,35,55,36,54,42,58,44,58,45,60,45,62,47,62,48,64,51,64,
54,66,54,68,52,71,52,76,48,80,48,83,45,87,45,88,42,91,42,94,43,95,
43,99,45,100,42,100,43,99,41,100,38,96,35,88,35,83,34,76,30,74,30,73,
26,66,26,62,28,57,27,56,24,56,22,53,21,53,21,52,19,52,19,51,16,51,
12,49,13,47,10,40,11,46,10,46,8,42,8,38,7,37,7,32,11,27,12,27,12,26,
11,24,12,19,9,17,7,18,6,18,6,19,4,19,2,20,2,16,
5,
31,8,34,7,35,8,32,9,31,8,
4,
34,9,36,9,34,11,34,9,
5,
36,7,38,7,38,8,36,8,36,7,
40,
42,7,46,4,44,4,43,6,41,6,41,5,44,4,48,2,50,2,51,3,50,4,54,3,58,3,61,1,
64,1,65,3,67,3,67,4,65,8,64,8,62,10,63,10,63,11,59,12,58,14,57,14,
53,19,51,18,49,14,51,12,51,11,52,11,52,8,48,8,47,7,50,4,48,4,45,8,
44,7,42,7,
6,
62,13,66,13,67,14,64,16,62,14,62,13,
7,
25,46,26,45,28,45,31,47,29,48,29,47,25,46,
5,
32,47,34,48,32,49,31,48,32,47,
5,
78,5,80,5,81,6,79,7,78,5,
4,
81,4,82,4,82,5,81,4,
4,
81,6,82,6,82,7,81,6,
8,
94,10,94,8,97,6,98,6,98,7,95,9,95,10,94,10,
9,
96,70,98,69,98,68,99,67,100,70,98,76,96,77,95,75,96,70,
5,
140,20,143,23,143,25,142,25,140,20,
5,
143,26,145,26,146,27,144,29,143,26,
9,
145,29,147,30,147,33,143,36,142,35,144,34,142,34,145,32,145,29,
5,
139,40,140,40,140,43,139,42,139,40,
7,
140,46,141,45,142,48,143,50,142,50,139,48,140,46,
4,
140,51,140,52,139,53,140,51,
4,
142,50,143,52,142,52,142,50,
10,
144,52,145,53,144,56,143,55,143,54,142,54,142,53,142,52,143,52,144,52,
9,
138,54,140,54,140,60,138,62,135,62,134,60,134,57,136,57,138,54,
8,
141,58,144,58,144,59,142,59,143,64,141,64,140,62,141,58,
5,
145,58,146,58,146,59,145,59,145,58,
15,
147,59,149,59,150,60,152,60,156,62,158,64,160,64,158,66,160,68,157,68,
155,66,152,67,151,64,148,62,147,59,
4,
143,66,140,66,140,67,141,67,
2,
143,67,144,66,
13,
160,86,162,86,163,90,160,93,159,92,154,96,152,96,152,95,158,91,
159,92,159,90,161,89,160,86,
26,
133,85,134,83,134,76,136,74,138,74,143,70,145,70,148,68,150,68,
150,70,152,72,153,68,154,68,156,76,158,78,152,88,146,89,148,90,
148,91,146,92,146,89,144,84,139,84,139,85,134,85,133,84,
10,
126,55,127,55,133,61,132,65,136,66,137,65,136,64,131,64,126,57,126,55,
9,
68,20,70,19,71,20,71,22,72,23,72,24,68,25,69,22,68,20,
5,
68,22,68,24,66,24,67,22,68,22,
178,
65,36,60,44,60,52,66,57,74,57,74,60,77,64,77,68,76,70,76,73,81,83,
86,83,91,76,91,73,94,70,94,66,93,64,93,62,100,54,100,51,96,52,
92,47,90,40,94,46,96,50,100,49,102,48,105,44,103,42,108,42,110,45,
112,45,113,52,115,55,116,55,117,52,117,55,118,55,118,53,117,52,
118,48,122,44,127,51,127,53,130,58,132,58,132,57,128,52,128,50,
132,54,134,52,134,50,132,46,132,44,136,44,138,42,139,36,136,34,
136,32,134,32,134,30,137,30,139,34,140,34,141,33,139,30,139,28,
141,28,141,28,136,18,136,16,141,16,141,14,143,14,143,18,147,21,
148,20,145,15,148,12,147,10,150,10,149,8,146,8,144,7,138,7,138,8,
134,8,134,7,126,7,